home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / gnu_tile_forth.lha / tst / bitsets.tst < prev    next >
Text File  |  1992-05-19  |  774b  |  36 lines
  1. .( Loading Bitsets test...) cr
  2.  
  3. #include blocks.f83
  4. #include bitsets.f83
  5.  
  6. bitsets blocks
  7.  
  8. bitset.type COLORS ( -- )
  9.   item white ( -- item)
  10.   item black ( -- item)
  11.   item blue ( -- item)
  12.   item red ( -- item)
  13.   item yellow ( -- item)
  14.   item green ( -- item)
  15.   item brown ( -- item)
  16.   item violet ( -- item)
  17. bitset.end
  18.  
  19. COLORS colors ( -- addr)
  20.  
  21. { yellow red blue }    constant primary
  22. { green brown violet } constant secondary
  23.  
  24. secondary .bitset COLORS cr
  25.  
  26. yellow empty-bitset add-bitset dup .bitset COLORS cr
  27. green swap add-bitset .bitset COLORS cr
  28. brown secondary remove-bitset .bitset COLORS cr
  29.  
  30. primary secondary union-bitset .bitset COLORS cr
  31. blue primary remove-bitset .bitset COLORS cr
  32.  
  33. { brown blue yellow } primary intersection-bitset .bitset COLORS cr
  34.  
  35. forth only
  36.